home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2009 February / PCWFEB09.iso / Software / Shareware / IDimager Personal 4.2.0.3 / setup_IDimager_Personal_V4.exe / {app} / Scripts / Meta Data Scripts / Remove all existing IPTC.psc < prev    next >
Encoding:
Text File  |  2008-02-16  |  1.2 KB  |  59 lines
  1. {
  2.   Description: This script will remove the full IPTC from selected images
  3.   Author: HB van Zwietering
  4.   Initial date: 2006-12-18
  5. }
  6.  
  7. var
  8.   ATif: TTif;
  9.   ATag: TTifTag;
  10.   i: Integer;
  11. begin
  12.   if Selected.Count = 0 then
  13.   begin
  14.     Say ('No selection made.');
  15.     exit;
  16.   end;
  17.  
  18.   if not Ask ('Are you sure you want to remove full IPTC for the selected images?') then
  19.     exit;
  20.  
  21.   Progress.Cancel := False;
  22.   Progress.ProgressBar := True;
  23.   Progress.Max := Selected.Count;
  24.   Progress.Show;
  25.  
  26.   ATif := TTif.Create (nil);
  27.     for i := 0 to Selected.Count - 1 do
  28.     begin
  29.       Progress.ProgressText := Selected.Items[i].FileName;
  30.       Progress.Pos := i + 1;
  31.       if Progress.Cancel then
  32.         break;
  33.  
  34.       if not Selected.Items[i].CanUpdateExif then
  35.         Continue;
  36.  
  37.       ATif.Reset;
  38.       ATif.FileName := Selected.Items[i].ExifFileName;
  39.  
  40.       ATif.Load (True, False);
  41.  
  42.       ATif.RemoveIPTC;
  43.  
  44.       ATag := ATif.FindTag ($10E, [itBase]);        // image description
  45.       if Assigned (ATag) then
  46.       begin
  47.         ATag.Free;
  48.       end;
  49.  
  50.       ATif.UpdateTags;
  51.     end;
  52.   ATif.Free;
  53.  
  54.   Progress.Hide;
  55.  
  56.   if Progress.Cancel then
  57.     Say ('Cancelled');
  58. end;
  59.